home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1995 November / EnigmA AMIGA RUN 02 (1995)(G.R. Edizioni)(IT)[!][issue 1995-11][Skylink CD].iso / earcd / util / text / megaed12.lha / MegaEdV1_2 / Trans / A68k.trans.p < prev    next >
Text File  |  1992-09-02  |  3KB  |  153 lines
  1. PROGRAM PCQTrans;
  2.  
  3. {
  4.     Konvertiert A68k-Fehlerdateien für MegaEd
  5.     von Wurzelsepp, 100% PD
  6. }
  7.  
  8. {$I "include:exec/memory.i" }
  9. {$I "include:libraries/dosextens.i" }
  10. {$I "include:utils/Stringlib.i" }
  11.  
  12. CONST
  13.     file1   :   String  =   "T:MegaEdMake-ErrFile";
  14.     file2   :   String  =   "T:MegaEdMake-Errors";
  15.     error   :   String  =   "E";
  16.     back    :   String  =   "/";
  17.     ret     :   Char    =   CHR(10);
  18.  
  19.     ver_text : String = "\0$VER: MegaEd-TransA68k V1.0 (16.03.95)";
  20.  
  21. VAR
  22.     fileh       :   FileHandle;
  23.     meldung     :   BOOLEAN;
  24.     zeile,
  25.     spalte      :   String;
  26.     las,
  27.     len,
  28.     dummy       :   INTEGER;
  29.     old         :   Address;
  30.     off         :   ^Char;
  31.  
  32. PROCEDURE TickleOn;
  33.  
  34. BEGIN
  35.  Inc(las);
  36.  off:=Address(Integer(off)+1);
  37. END;
  38.  
  39. BEGIN
  40.  
  41.  IF DeleteFile(file2) THEN ;
  42.  
  43.  zeile:=AllocString (255);
  44.  spalte:=AllocString (255);
  45.  
  46.  meldung:=FALSE;
  47.  fileh:=DOSOpen (file1,MODE_OLDFILE);
  48.  IF fileh<>NIL THEN
  49.  BEGIN
  50.   dummy:=Seek(fileh,0,OFFSET_END);
  51.   len:=Seek(fileh,0,OFFSET_BEGINNING);
  52.   if len>0 THEN
  53.   BEGIN
  54.    old:=AllocMem (len,MEMF_PUBLIC+MEMF_CLEAR);
  55.    IF old=NIL THEN
  56.    BEGIN
  57.     DOSClose (fileh);
  58.     Exit;
  59.    END;
  60.    IF DOSRead(fileh,old,len)<>len THEN
  61.    BEGIN
  62.     FreeMem(old,len);
  63.     DOSClose(fileh);
  64.     Exit;
  65.    END;
  66.   END;
  67.   DOSClose(fileh);
  68.   IF (len=0) THEN Exit;
  69.  
  70.   fileh:=DOSOpen (file2,MODE_NEWFILE);
  71.   IF fileh<>NIL THEN
  72.   BEGIN
  73.  
  74.    las:=0;
  75.    off:=old;
  76.    WHILE las<len DO
  77.    BEGIN
  78.     WHILE (off^<>ret) AND (las<len) DO
  79.      TickleOn;
  80.     IF las<len THEN
  81.     BEGIN
  82.      TickleOn;  { Return überspringen }
  83.  
  84.      WHILE (off^<>ret) AND (las<len) DO
  85.       TickleOn;
  86.      IF las<len THEN
  87.      BEGIN
  88.       { Return der Einleitungszeile (mit Filenamen) überspringen }
  89.       TickleOn;
  90.  
  91.       WHILE (off^=' ') AND (las<len) DO
  92.        TickleOn;
  93.       meldung:=TRUE;
  94.       FOR dummy:=0 TO 200 DO zeile[dummy]:=CHR(0);
  95.       WHILE (off^<>' ') AND (off^<>CHR(9)) AND (las<len) DO
  96.       BEGIN
  97.        zeile[StrLen(zeile)]:=off^;
  98.        TickleOn;
  99.       END;
  100.       IF las<len THEN
  101.       BEGIN
  102.        WHILE (off^<>ret) AND (las<len) DO
  103.         TickleOn;
  104.        TickleOn; { Wiederholung des Sources + Return überspringen }
  105.        IF las<len THEN
  106.        BEGIN
  107.         WHILE (off^<>ret) AND (las<len) DO
  108.         BEGIN
  109.          { große Schleife zum Auslesen mehrerer Fehler in einer Zeile }
  110.          dummy:=0;
  111.          WHILE (off^<>'^') AND (las<len) DO
  112.          BEGIN
  113.           Inc(dummy);
  114.           TickleOn;
  115.          END;
  116.          IF las<len THEN
  117.          BEGIN
  118.           { "^" und " " überspringen }
  119.           TickleOn;
  120.           TickleOn;
  121.           IF IntToStr (spalte,dummy)=0 THEN ;
  122.           dummy:=DOSWrite (fileh,error,StrLen(error));
  123.           dummy:=DOSWrite (fileh,zeile,StrLen(zeile));
  124.           dummy:=DOSWrite (fileh,back,StrLen(back));
  125.           dummy:=DOSWrite (fileh,spalte,StrLen(spalte));
  126.           dummy:=DOSWrite (fileh,Adr(ret),1);
  127.           WHILE (off^<>ret) AND (las<len) DO
  128.           BEGIN
  129.            dummy:=DOSWrite (fileh,off,1);
  130.            TickleOn;
  131.           END;
  132.           TickleOn; { Return überspringen }
  133.           dummy:=DOSWrite (fileh,Adr(ret),1);
  134.          END;
  135.         END;
  136.        END;
  137.       END;
  138.      END;
  139.     END;
  140.    END;
  141.    DOSClose (fileh);
  142.   END;
  143.  
  144.   FreeMem(old,len);
  145.  
  146.  END;
  147.  
  148.  IF meldung=FALSE THEN
  149.   IF DeleteFile(file2) THEN ;
  150.  
  151. END.
  152.  
  153.